########################################################################
##
##  Purpose: This script produces Figure 1 from the manuscript
##  Author: james.h.bisbee@vanderbilt.edu
##  Date: 05/18/2024
##
##  Input Files:
##    - ./data/for_replication.rds
##  Output Files:
##    - ./output/Figures/MUSK_fig1.pdf
##
########################################################################
rm(list = ls())
gc()
require(changepoint)
require(tidyverse)
require(ggridges)
require(patchwork)
# Compute details
Sys.info()
# sysname        release        version       nodename
# "Windows"       "10 x64"  "build 22631"   "AS-GR3RGY3"
# machine          login           user effective_user
# "x86-64"     "bisbeejh"     "bisbeejh"     "bisbeejh"
ram_size = system("wmic MemoryChip get Capacity", intern = TRUE)[-1]
model_name = system("wmic cpu get name", intern = TRUE)[2] # nocov
vendor_id = system("wmic cpu get manufacturer", intern = TRUE)[2] # nocov
print(list(ram = stringr::str_squish(ram_size)[1],
vendor_id = stringr::str_squish(vendor_id),
model_name = stringr::str_squish(model_name),
no_of_cores = parallel::detectCores()))
# $ram
# [1] "17179869184"
#
# $vendor_id
# [1] "GenuineIntel"
#
# $model_name
# [1] "13th Gen Intel(R) Core(TM) i9-13900H"
#
# $no_of_cores
# [1] 20
# Package details
sessionInfo()
# attached base packages:
# [1] stats     graphics  grDevices utils     datasets
# [6] methods   base
#
# other attached packages:
#  [1] patchwork_1.1.3   ggridges_0.5.4    lubridate_1.9.2
#  [4] forcats_1.0.0     stringr_1.5.0     dplyr_1.1.2
#  [7] purrr_1.0.1       readr_2.1.4       tidyr_1.3.0
# [10] tibble_3.2.1      ggplot2_3.4.4     tidyverse_2.0.0
# [13] changepoint_2.2.4 zoo_1.8-12
#
# loaded via a namespace (and not attached):
#  [1] vctrs_0.6.3       cli_3.6.1         rlang_1.1.1
#  [4] stringi_1.7.12    generics_0.1.3    glue_1.6.2
#  [7] colorspace_2.1-0  hms_1.1.3         scales_1.3.0
# [10] fansi_1.0.4       grid_4.3.3        munsell_0.5.0
# [13] tzdb_0.4.0        lifecycle_1.0.3   compiler_4.3.3
# [16] timechange_0.2.0  pkgconfig_2.0.3   rstudioapi_0.15.0
# [19] lattice_0.22-5    R6_2.5.1          tidyselect_1.2.0
# [22] utf8_1.2.3        pillar_1.9.0      magrittr_2.0.3
# [25] tools_4.3.3       withr_2.5.0       gtable_0.3.3
finalFullUsers <- read_rds('./data/for_replication.rds')
toplot <- finalFullUsers %>%
group_by(created_at) %>%
summarise(nTweets = sum(nTweets,na.rm=T),
nAccounts = length(unique(sn))) %>%
gather(metric,value,-created_at)
# Left Facet
pAccounts <- toplot %>%
filter(metric == 'nAccounts') %>%
mutate(metric = ifelse(metric == 'nAccounts','# Active Accounts','# Tweets')) %>%
ggplot(aes(x = created_at,y = value)) +
geom_point() +
geom_vline(xintercept = as.Date('2022-10-28'),linetype = 'dashed',size = 1.1,color = 'red') +
annotate(geom = 'label',x = as.Date('2022-10-28'),y = Inf,label = 'Musk',vjust = 1,hjust = .5) +
facet_wrap(~metric,scales = 'free_y') +
theme_bw() +
labs(x = 'Date',
y = 'Number of accounts')
# Right Facet
pTweets <- toplot %>%
filter(metric == 'nTweets') %>%
mutate(metric = ifelse(metric == 'nAccounts','# Active Accounts','# Tweets')) %>%
ggplot(aes(x = created_at,y = value)) +
geom_point() +
geom_vline(xintercept = as.Date('2022-10-28'),linetype = 'dashed',size = 1.1,color = 'red') +
annotate(geom = 'label',x = as.Date('2022-10-28'),y = Inf,label = 'Musk',vjust = 1,hjust = .5) +
facet_wrap(~metric,scales = 'free_y') +
theme_bw() +
labs(x = 'Date',
y = 'Number of tweets')
pdf('./output/Figures/MUSK_fig1.pdf',width = 7,height = 3)
pAccounts + pTweets
dev.off()
# EOF
########################################################################
##
##  Purpose: This script produces Figure 2 from the manuscript
##  Author: james.h.bisbee@vanderbilt.edu
##  Date: 05/18/2024
##
##  Input Files:
##    - ./data/for_replication.rds
##  Output Files:
##    - ./output/Figures/MUSK_fig2.pdf
##
########################################################################
rm(list = ls())
gc()
require(tidyverse)
require(ggridges)
require(changepoint)
# Compute details
Sys.info()
# sysname        release        version       nodename
# "Windows"       "10 x64"  "build 22631"   "AS-GR3RGY3"
# machine          login           user effective_user
# "x86-64"     "bisbeejh"     "bisbeejh"     "bisbeejh"
ram_size = system("wmic MemoryChip get Capacity", intern = TRUE)[-1]
model_name = system("wmic cpu get name", intern = TRUE)[2] # nocov
vendor_id = system("wmic cpu get manufacturer", intern = TRUE)[2] # nocov
print(list(ram = stringr::str_squish(ram_size)[1],
vendor_id = stringr::str_squish(vendor_id),
model_name = stringr::str_squish(model_name),
no_of_cores = parallel::detectCores()))
# $ram
# [1] "17179869184"
#
# $vendor_id
# [1] "GenuineIntel"
#
# $model_name
# [1] "13th Gen Intel(R) Core(TM) i9-13900H"
#
# $no_of_cores
# [1] 20
# Package details
sessionInfo()
# attached base packages:
# [1] stats     graphics  grDevices utils     datasets
# [6] methods   base
#
# other attached packages:
#  [1] changepoint_2.2.4 zoo_1.8-12        ggridges_0.5.4
#  [4] lubridate_1.9.2   forcats_1.0.0     stringr_1.5.0
#  [7] dplyr_1.1.2       purrr_1.0.1       readr_2.1.4
# [10] tidyr_1.3.0       tibble_3.2.1      ggplot2_3.4.4
# [13] tidyverse_2.0.0
#
# loaded via a namespace (and not attached):
#  [1] vctrs_0.6.3       cli_3.6.1         rlang_1.1.1
#  [4] stringi_1.7.12    generics_0.1.3    glue_1.6.2
#  [7] colorspace_2.1-0  hms_1.1.3         scales_1.3.0
# [10] fansi_1.0.4       grid_4.3.3        munsell_0.5.0
# [13] tzdb_0.4.0        lifecycle_1.0.3   compiler_4.3.3
# [16] timechange_0.2.0  pkgconfig_2.0.3   rstudioapi_0.15.0
# [19] lattice_0.22-5    R6_2.5.1          tidyselect_1.2.0
# [22] utf8_1.2.3        pillar_1.9.0      magrittr_2.0.3
# [25] tools_4.3.3       withr_2.5.0       gtable_0.3.3
finalFullUsers <- read_rds('./data/for_replication.rds')
toMerge <- finalFullUsers %>%
filter(type == 'Retweet') %>%
mutate(created_at = lubridate::round_date(created_at,unit = 'week',week_start = 3)) %>%
group_by(sn,created_at) %>%
summarise(nTweets = sum(nTweets,na.rm=T),
nAccounts = length(unique(sn))) %>%
ungroup()
# Weekly change
grid <- expand.grid(created_at = lubridate::as_datetime(seq.Date(from = as.Date('2020-01-01'),to = as.Date('2023-02-01'),by = 'week')),
sn = unique(toMerge$sn))
toplot <- grid %>%
left_join(toMerge) %>%
mutate_at(vars(matches('nTweet|nAccount')),function(x) ifelse(is.na(x),0,x)) %>%
as_tibble() %>%
group_by(sn) %>%
arrange(created_at) %>%
mutate(diffTweets = nTweets - lag(nTweets,n = 52),
diffAccounts = nAccounts - lag(nAccounts,n = 52)) %>%
group_by(created_at) %>%
mutate(nUsers = n(),
nTweets = sum(nTweets)) %>%
summarise_at(vars(matches('^n|diff')),mean)
pdf('./output/Figures/MUSK_fig2.pdf',width = 7,height = 5)
toplot %>%
filter(created_at > as.Date('2022-01-01')) %>%
ggplot(aes(x = created_at,y = diffTweets,fill = diffTweets < 0,group = 1)) +
geom_bar(stat = 'identity') +
geom_smooth(method = 'gam') +
scale_fill_manual(guide = 'none',values = c('darkgreen','darkred')) +
theme_bw() +
geom_vline(xintercept = lubridate::as_datetime('2022-10-28'),
size = 1.1,linetype = 'dashed',color = 'red') +
annotate(geom = 'label',x = lubridate::as_datetime('2022-10-28'),
y = Inf,label = 'Musk',
angle = 90,vjust = .5,hjust = 1) +
labs(title = 'Annual Change in Weekly Tweets',
x = 'Date',
y = 'Annual Change') +
xlim(lubridate::as_datetime(c('2021-12-01','2023-02-15')))
dev.off()
# EOF
########################################################################
##
##  Purpose: This script produces Figure 3 from the manuscript
##  Author: james.h.bisbee@vanderbilt.edu
##  Date: 05/18/2024
##
##  Input Files:
##    - ./data/for_replication.rds
##  Output Files:
##    - ./output/Figures/MUSK_fig3.pdf
##
########################################################################
rm(list = ls())
gc()
require(changepoint)
require(tidyverse)
require(ggridges)
# Compute details
Sys.info()
# sysname        release        version       nodename
# "Windows"       "10 x64"  "build 22631"   "AS-GR3RGY3"
# machine          login           user effective_user
# "x86-64"     "bisbeejh"     "bisbeejh"     "bisbeejh"
ram_size = system("wmic MemoryChip get Capacity", intern = TRUE)[-1]
model_name = system("wmic cpu get name", intern = TRUE)[2] # nocov
vendor_id = system("wmic cpu get manufacturer", intern = TRUE)[2] # nocov
print(list(ram = stringr::str_squish(ram_size)[1],
vendor_id = stringr::str_squish(vendor_id),
model_name = stringr::str_squish(model_name),
no_of_cores = parallel::detectCores()))
# $ram
# [1] "17179869184"
#
# $vendor_id
# [1] "GenuineIntel"
#
# $model_name
# [1] "13th Gen Intel(R) Core(TM) i9-13900H"
#
# $no_of_cores
# [1] 20
# Package details
sessionInfo()
# attached base packages:
# [1] stats     graphics  grDevices utils     datasets
# [6] methods   base
#
# other attached packages:
#  [1] ggridges_0.5.4    lubridate_1.9.2   forcats_1.0.0
#  [4] stringr_1.5.0     dplyr_1.1.2       purrr_1.0.1
#  [7] readr_2.1.4       tidyr_1.3.0       tibble_3.2.1
# [10] ggplot2_3.4.4     tidyverse_2.0.0   changepoint_2.2.4
# [13] zoo_1.8-12
#
# loaded via a namespace (and not attached):
#  [1] vctrs_0.6.3       cli_3.6.1         rlang_1.1.1
#  [4] stringi_1.7.12    generics_0.1.3    glue_1.6.2
#  [7] colorspace_2.1-0  hms_1.1.3         scales_1.3.0
# [10] fansi_1.0.4       grid_4.3.3        munsell_0.5.0
# [13] tzdb_0.4.0        lifecycle_1.0.3   compiler_4.3.3
# [16] timechange_0.2.0  pkgconfig_2.0.3   rstudioapi_0.15.0
# [19] lattice_0.22-5    R6_2.5.1          tidyselect_1.2.0
# [22] utf8_1.2.3        pillar_1.9.0      magrittr_2.0.3
# [25] tools_4.3.3       withr_2.5.0       gtable_0.3.3
finalFullUsers <- read_rds('./data/for_replication.rds')
finalFullUsersSmaller <- finalFullUsers %>%
filter(created_at >= as.Date('2022-01-01'),
created_at <= as.Date('2023-06-01'))
toplot <- finalFullUsers %>%
group_by(created_at) %>%
summarise(mTweets = mean(nTweets,na.rm=T),
nTweets = sum(nTweets,na.rm=T),
nAccounts = length(unique(sn))) %>%
gather(metric,value,-created_at) %>%
ungroup() %>%
mutate(weekday = lubridate::wday(created_at,label = T)) %>%
mutate(weekend = ifelse(weekday %in% c('Sun','Mon'),'Weekend','Weekday'))
# BCP confirmation
bcpRes <- NULL
for(met in c('nTweets','nAccounts')) {
for(t in unique(finalFullUsersSmaller$type)) {
if(is.na(t)) { next }
cat(met,t,'\n')
# stop()
toplotTmpF <- finalFullUsersSmaller %>%
filter(type == t) %>%
group_by(created_at) %>%
summarise(mTweets = mean(nTweets,na.rm=T),
nTweets = sum(nTweets,na.rm=T),
nAccounts = length(unique(sn))) %>%
gather(metric,value,-created_at) %>%
ungroup() %>%
filter(metric == met)
cptTmp <- cpt.mean(toplotTmpF %>%
pull(value))
bcpRes <- bcpRes %>%
bind_rows(data.frame(metric = met,
type = t,
date = (toplotTmpF %>%
pull(created_at))[cptTmp@cpts[1]],
sample = 'Full') %>%
as_tibble())
for(i in 1:100) {
samp <- sample(unique(finalFullUsersSmaller$sn),size = 5000,replace = T)
toplotTmp <- finalFullUsersSmaller %>%
filter(type == t) %>%
filter(sn %in% samp) %>%
group_by(created_at) %>%
summarise(mTweets = mean(nTweets,na.rm=T),
nTweets = sum(nTweets,na.rm=T),
nAccounts = length(unique(sn))) %>%
gather(metric,value,-created_at) %>%
ungroup() %>%
filter(metric == met)
cptTmp <- changepoint::cpt.mean(toplotTmp$value)
bcpRes <- bcpRes %>%
bind_rows(data.frame(metric = met,
type = t,
date = (toplotTmp %>%
pull(created_at))[cptTmp@cpts[1]],
sample = paste0('bs_',i)) %>%
as_tibble())
}
}
}
pdf('./output/Figures/MUSK_fig3.pdf',width = 7,height = 5)
bcpRes %>%
filter(sample != 'Full') %>%
mutate(metric = ifelse(metric == 'nAccounts','# of accounts tweeting','# of tweets posted')) %>%
ggplot(aes(x = date)) +
geom_bar(color = 'grey30',size = 1.2) +
facet_grid(type~metric,scales = 'free') +
geom_vline(xintercept = as.Date('2022-10-28'),
linetype = 'dashed',color = 'red') +
theme_bw() +
labs(x = 'Date',y = '% of 100 Random Samples',
title = 'Bootstrapped BCP Estimate',
subtitle = '100 random samples for two measures (columns) and four types of tweets (rows)')
dev.off()
# EOF
########################################################################
##
##  Purpose: This script produces Table 1 from the manuscript
##  Author: james.h.bisbee@vanderbilt.edu
##  Date: 05/18/2024
##
##  Input Files:
##    - ./data/for_replication.rds
##  Output Files:
##    - ./output/Tables/tab_1.tex
##
########################################################################
rm(list = ls())
gc()
require(changepoint)
require(tidyverse)
require(ggridges)
require(fixest)
# Compute details
Sys.info()
# sysname        release        version       nodename
# "Windows"       "10 x64"  "build 22631"   "AS-GR3RGY3"
# machine          login           user effective_user
# "x86-64"     "bisbeejh"     "bisbeejh"     "bisbeejh"
ram_size = system("wmic MemoryChip get Capacity", intern = TRUE)[-1]
model_name = system("wmic cpu get name", intern = TRUE)[2] # nocov
vendor_id = system("wmic cpu get manufacturer", intern = TRUE)[2] # nocov
print(list(ram = stringr::str_squish(ram_size)[1],
vendor_id = stringr::str_squish(vendor_id),
model_name = stringr::str_squish(model_name),
no_of_cores = parallel::detectCores()))
# $ram
# [1] "17179869184"
#
# $vendor_id
# [1] "GenuineIntel"
#
# $model_name
# [1] "13th Gen Intel(R) Core(TM) i9-13900H"
#
# $no_of_cores
# [1] 20
# Package details
sessionInfo()
# attached base packages:
# [1] stats     graphics  grDevices utils     datasets
# [6] methods   base
#
# other attached packages:
#  [1] fixest_0.11.1     ggridges_0.5.4    lubridate_1.9.2
#  [4] forcats_1.0.0     stringr_1.5.0     dplyr_1.1.2
#  [7] purrr_1.0.1       readr_2.1.4       tidyr_1.3.0
# [10] tibble_3.2.1      ggplot2_3.4.4     tidyverse_2.0.0
# [13] changepoint_2.2.4 zoo_1.8-12
#
# loaded via a namespace (and not attached):
#  [1] gtable_0.3.3        compiler_4.3.3
#  [3] Rcpp_1.0.11         tidyselect_1.2.0
#  [5] scales_1.3.0        lattice_0.22-5
#  [7] R6_2.5.1            generics_0.1.3
#  [9] Formula_1.2-5       munsell_0.5.0
# [11] pillar_1.9.0        tzdb_0.4.0
# [13] rlang_1.1.1         utf8_1.2.3
# [15] stringi_1.7.12      timechange_0.2.0
# [17] cli_3.6.1           withr_2.5.0
# [19] magrittr_2.0.3      grid_4.3.3
# [21] rstudioapi_0.15.0   hms_1.1.3
# [23] sandwich_3.0-2      nlme_3.1-164
# [25] lifecycle_1.0.3     vctrs_0.6.3
# [27] glue_1.6.2          numDeriv_2016.8-1.1
# [29] fansi_1.0.4         colorspace_2.1-0
# [31] dreamerr_1.2.3      tools_4.3.3
# [33] pkgconfig_2.0.3
toanal <- read_rds('./data/for_replication.rds')
res <- list()
for(t in c('Original','Retweet','Reply','Quote')) {
if(is.na(t)) { next }
res[[t]] <- feols(log(nTweets+1) ~ verified*post + poly(trend,2) | sn,
toanal %>%
filter(created_at > as.Date('2022-10-19')) %>%
filter(type == t) %>%
mutate(post = created_at > as.Date('2022-11-19'),
trend = as.numeric(created_at) - min(as.numeric(created_at))))
}
dict <- c(postTRUE = 'Post 11/19',
verifiedTRUE = 'Verified',
sn = 'Account')
etable(res,drop = 'trend',
dict = dict,extralines = list('Quadratic Time Trends' = c('Yes','Yes','Yes','Yes')),
headers=list("Original Tweets" = 1,"Retweets" = 1,'Replies' = 1,'Quotes' = 1),
depvar = F,digits = 3,digits.stats = 3,file = './output/Tables/tab_1.tex',replace = T)
# EOF
